home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / comm / suncom.zip / MYDOS.PAS < prev    next >
Pascal/Delphi Source File  |  1990-01-19  |  8KB  |  241 lines
  1. UNIT MyDos;
  2.  
  3. INTERFACE
  4.  
  5. USES Dos,Crt,Windows;
  6.  
  7. FUNCTION  Drive_Number(Path : String) : Integer;
  8. FUNCTION  DiskVolumeID(Path : String) : String;
  9. PROCEDURE Directory(Foreground1,
  10.                     Foreground2,
  11.                     BackGround,
  12.                     FrameType    : Byte);
  13. PROCEDURE FILECOPIER(Source,
  14.                      Destination : String;
  15.                      IOError     : Byte);
  16.  
  17. IMPLEMENTATION
  18. (*****************************************************************************)
  19.  
  20. FUNCTION Drive_Number;
  21. begin
  22.      Drive_Number := -1;
  23.      case Path[1] of
  24.              'A','a' : Drive_Number := 1;
  25.              'B','b' : Drive_Number := 2;
  26.              'C','c' : Drive_Number := 3;
  27.              'D','d' : Drive_Number := 4;
  28.              'E','e' : Drive_Number := 5;
  29.              'F','f' : Drive_Number := 6;
  30.              'G','g' : Drive_Number := 7;
  31.      end;
  32. end;
  33.  
  34. (*****************************************************************************)
  35.  
  36. FUNCTION DiskVolumeID;
  37. VAR FileInfo       : SearchRec;
  38.     DiskVolID      : String;
  39.     LCV            : Integer;
  40. begin
  41.      FindFirst('*.*',VolumeID,FileInfo);
  42.      DiskVolID := FileInfo.Name;
  43.      for LCV := 1 to length(DiskVolID) do
  44.          if DiskVolID[LCV] = '.'
  45.             then delete(DiskVolID,LCV,1);
  46.      for LCV := 1 to length(DiskVolID) do
  47.          if not (DiskVolID[LCV] in [' '..'z'])
  48.             then DiskVolID := 'No Label';
  49. end;
  50.  
  51. (*****************************************************************************)
  52.  
  53. PROCEDURE Directory;
  54. VAR FileInfo               : SearchRec;
  55.     TimeNow                : DateTime;
  56.     FileTimeStamp,
  57.     NumFiles,
  58.     NumDirectories         : LongInt;
  59.     FileReference          : File of Byte;
  60.     Question,
  61.     AmPm                   : Char;
  62.     DirPattern,
  63.     DirPath,
  64.     DirPattern2            : String;
  65.     Counter                : Integer;
  66. LABEL Beginning;
  67.  
  68. FUNCTION STR2(Number : Integer) : String;
  69. VAR NewString : String;
  70. begin
  71.    Str(Number,NewString);
  72.    if Length(NewString) = 1 then Insert('0',NewString,1);
  73.    if Length(NewString) = 4 then Delete(NewString,1,2);
  74.    STR2 := NewString;
  75. end;
  76.  
  77. BEGIN
  78.      window(1,1,80,25);
  79.      NumFiles := 0;
  80.      NumDirectories := 0;
  81.      Beginning:
  82.      {$i-}
  83.      WINDOWIN(Foreground1,Background,FrameType,10,10,70,13,CursorCol,CursorRow,WindowPtr);
  84.      textcolor(ForeGround1);
  85.      write('Directory Pattern: ');
  86.      textcolor(ForeGround2);
  87.      readln(DirPattern);
  88.      textcolor(ForeGround1);
  89.      write('Directory Path: ');
  90.      textcolor(ForeGround2);
  91.      readln(DirPath);
  92.      ChDir(DirPath);
  93.      if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
  94.         then begin
  95.                   {$i+}
  96.                   DirPattern := '*.*';
  97.              end;
  98.      {$i+}
  99.      if length(DirPath) >=3
  100.         then begin
  101.                   DirPattern2 := DirPath+'\'+DirPattern;
  102.                   {$i-}
  103.                   ChDir(DirPath);
  104.                   DirPattern2 := DirPattern;
  105.                   if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
  106.                      then begin
  107.                                {$i+}
  108.                                 WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  109.                                 exit;
  110.                           end;
  111.                   {$i+}
  112.              end
  113.         else begin
  114.                  {$i-}
  115.                   ChDir(DirPath+'\');
  116.                   DirPattern2 := DirPattern;
  117.                   if (IOresult <> 0) or (length(DirPattern) < 3) or (length(DirPath) < 2)
  118.                      then begin
  119.                                {$i+}
  120.                                 WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  121.                                 exit;
  122.                           end;
  123.                   {$i+}
  124.              end;
  125.      OFFCURSOR;
  126.      window(1,1,80,25);
  127.      clrscr;
  128.      MAKEWINDOW(black,white,4,0,15,1,65,5);
  129.      write(' Disk Volume ID: ');
  130.      textcolor(red);
  131.      writeln(DiskVolumeID(DirPattern2));
  132.      textcolor(black);
  133.      write(' Directory of: ');
  134.      textcolor(red);
  135.      writeln(DirPath+'\'+DirPattern);
  136.      textcolor(black);
  137.      write(' Space Free: ');
  138.      textcolor(red);
  139.      write(DiskFree(Drive_Number(DirPath[1])),' Bytes');
  140.      MAKEWINDOW(black,white,4,0,15,7,65,23);
  141.      Counter := 0;
  142.      FindFirst(DirPattern2,AnyFile,FileInfo);
  143.      while (DosError = 0) do
  144.         begin
  145.              Assign(FileReference,FileInfo.Name);
  146.              if (FileInfo.Attr = 32) or (FileInfo.Attr = 16)
  147.                then begin
  148.                       if FileInfo.Attr = 32
  149.                          then begin
  150.                                    Reset(FileReference);
  151.                                    NumFiles := NumFiles + 1;
  152.                                    GetFTime(FileReference,FileTimeStamp);
  153.                                    UnPackTime(FileTimeStamp,TimeNow);
  154.                                    write(FileInfo.Name:12,FileSize(FileReference):9);
  155.                                    with TimeNow do
  156.                                         begin
  157.                                              if Hour > 12
  158.                                                 then begin
  159.                                                           Hour := Hour - 12;
  160.                                                           AmPm := 'p';
  161.                                                      end
  162.                                                 else AmPm := 'a';
  163.                                              write(' Bytes  ',STR2(Month),'/',STR2(Day),'/',STR2(Year),'  ');
  164.                                              writeln(STR2(Hour),':',STR2(Min)+AmPm);
  165.                                         end;
  166.                               end
  167.                          else begin
  168.                                  writeln(FileInfo.Name:12,'  <DIR>':9);
  169.                                  NumDirectories := NumDirectories + 1;
  170.                               end;
  171.                       Counter := Counter + 1;
  172.                       if Counter >= 14
  173.                          then begin
  174.                                    Counter := 0;
  175.                                    textcolor(red);
  176.                                    write('Press Any Key...');
  177.                                    Question := readkey;
  178.                                    textcolor(black);
  179.                                    writeln;
  180.                               end;
  181.                       if FileInfo.Attr = 32 then Close(FileReference);
  182.                       FindNext(FileInfo);
  183.                     end
  184.                else FindNext(FileInfo);
  185.            end;
  186.      textcolor(black);
  187.      write('Number of Files: ');
  188.      textcolor(yellow);
  189.      writeln(NumFiles);
  190.      textcolor(black);
  191.      write('Number of Directories: ');
  192.      textcolor(yellow);
  193.      writeln(NumDirectories);
  194.      textcolor(red);
  195.      write('Press Any Key...');
  196.      Question := readkey;
  197.      WINDOWOUT(CursorCol,CursorRow,WindowPtr);
  198.      ONCURSOR;
  199. end;
  200.  
  201. (*****************************************************************************)
  202.  
  203. PROCEDURE FILECOPIER;
  204. VAR  Buffer         : Array[1..8192] of char;
  205.      NumberOfBytes,
  206.      NumberRead,
  207.      NumberWritten  : word;
  208.      SourceFile,
  209.      DestFile       : File;
  210. BEGIN
  211.      NumberOfBytes := 1;
  212.      IOError := 0;
  213.      {$I-}
  214.      assign(SourceFile,Source);
  215.      reset(SourceFile,NumberOfBytes);
  216.      {$I+}
  217.      if IOResult <> 0 then
  218.         begin
  219.              IOError := 1;
  220.              exit;
  221.         end;
  222.      {$I-}
  223.      assign(DestFile,Destination);
  224.      rewrite(DestFile,NumberOfBytes);
  225.      {$I+}
  226.      if IOResult <> 0 then
  227.         begin
  228.              IOError := 2;
  229.              exit;
  230.         end;
  231.      repeat
  232.            BlockRead(SourceFile,Buffer,SizeOf(Buffer),NumberRead);
  233.            BlockWrite(DestFile,Buffer,NumberRead,NumberWritten);
  234.      until (NumberRead = 0) {or (NumberRead <> NumberWritten)};
  235.      close(SourceFile);
  236.      close(DestFile);
  237. END;
  238.  
  239. end. {unit}
  240.  
  241.